!     -------------
!     PROGRAM PROG2
!     -------------
!
!     PLANETARY TABLES FROM 1900 TO 2100.
!
!     Ref : JC-GF February 2000.
!
! --- Object -----------------------------------------------------------
!
!     This program allows to create a binary direct access file grouping
!     together the planetary tables stored in ASCII files.
!
! --- ASCII files ------------------------------------------------------
!
!     tab1.mer :   20 tables    3650 days   JD0 2415020.5.
!     tab2.ven :    8 tables    9120 days   JD0 2415020.5.
!     tab3.emb :    5 tables   14630 days   JD0 2415020.5.
!     tab4.mar :    5 tables   14630 days   JD0 2415020.5.
!     tab5.jup :    1 table    73080 days   JD0 2415020.5.
!     tab6.sat :    1 table    73080 days   JD0 2415020.5.
!     tab7.ura :    1 table    73080 days   JD0 2415020.5.
!     tab8.nep :    1 table    91400 days   JD0 2396758.5.
!     tab9.plu :    1 table   146120 days   JD0 2341972.5.
!
! --- Binary direct access file ----------------------------------------
!
!     File name : platab.dat   (1 record = 800 bytes).
!
!     Mercury                303  records.
!     Venus                  106  records.
!     Earth-Moon barycenter   78  records.
!     Mars                    68  records.
!     Jupiter                 12  records.
!     Saturn                  11  records.
!     Uranus                   9  records.
!     Neptune                  9  records.
!     Pluto                    9  records.
!
! --- Declarations -----------------------------------------------------
!
      implicit double precision (a-h,o-z)
!
      character*1 num(9)
      character*3 pla(9)
      character*10 fasc,fbin
!
      dimension nf(0:2),tab(15000)
!
      data num/'1','2','3','4','5','6','7','8','9'/
      data pla/'mer','ven','emb','mar','jup','sat','ura','nep','plu'/
!
! --- Open the binary direct access file -------------------------------
!
      fbin='platab.dat'
      open (10,file=fbin,access='direct',recl=800,
     .      status='new',iostat=nerr)
!
      if (nerr.ne.0) then
         write (*,2001) fbin
         stop
      endif
!
      nrec=0
      write (*,1001) fbin
!
! --- Planet loop ------------------------------------------------------
!
      do n=1,9
!
! ------ Open the ASCII files ------------------------------------------
!
         nul=10+n
         fasc='tab'//num(n)//'.'//pla(n)
         open (nul,file=fasc,status='old',iostat=nerr)
         if (nerr.ne.0) then
            write (*,2001) fasc
            stop
         endif
!
! ------ Header (parameters) -------------------------------------------
!
         read (nul,3001,iostat=nerr) tzero,dt,mx,imax,kblk
         if (nerr.ne.0) then
            write (*,2002) fasc
            stop
         endif
         nn=0
!
! ------ Frequencies -----------------------------------------------------------
!
         max=0
         do m=0,mx
            read (nul,3002,iostat=nerr) nf(m)
            if (nerr.ne.0) then
               write (*,2002) fasc
               stop
            endif
            do i=1,nf(m)
               max=max+1
               read (nul,3003,iostat=nerr) tab(max)
               if (nerr.ne.0) then
                  write (*,2002) fasc
                  stop
               endif
            enddo
         enddo
         nblk=max/100+1
         if (mod(max,100).eq.0) nblk=nblk-1
         do kb=1,nblk
            nrec=nrec+1
            jmin=(kb-1)*100+1
            jmax=min0(max,jmin+99)
            write (10,rec=nrec,iostat=nerr) (tab(j),j=jmin,jmax)
            nn=nn+1
            if (nerr.ne.0) then
               write (*,2003) fbin
               stop
            endif
         enddo
         read (nul,*)
!
! ------ Coefficients (sines and cosines) --------------------------------------
!
         do k=1,kblk
            max=0
            do iv=1,3
               read (nul,*)
               do i=0,imax,2
                  read (nul,3004,iostat=nerr) s1,s2
                  if (nerr.ne.0) then
                     write (*,2002) fasc
                     stop
                  endif
                  max=max+1
                  tab(max)=s1
                  max=max+1
                  tab(max)=s2
               enddo
               do m=0,mx
                  ip=mod(m,2)
                  do i=1,nf(m)
                     if (ip.eq.0) then
                        read (nul,3004,iostat=nerr) c,s
                     else
                        read (nul,3004,iostat=nerr) s,c
                     endif
                     if (nerr.ne.0) then
                        write (*,2002) fasc
                        stop
                     endif
                     max=max+1
                     tab(max)=c
                     max=max+1
                     tab(max)=s
                  enddo
               enddo
            enddo
            nblk=max/100+1
            if (mod(max,100).eq.0) nblk=nblk-1
            do kb=1,nblk
               nrec=nrec+1
               jmin=(kb-1)*100+1
               jmax=min0(max,jmin+99)
               write (10,rec=nrec,iostat=nerr) (tab(j),j=jmin,jmax)
               nn=nn+1
               if (nerr.ne.0) then
                  write (*,2003) fbin
                  stop
               endif
            enddo
         enddo
!
! ------ Close the ASCII files -----------------------------------------
!
         write (*,1002) n,fasc,nn
         close (nul)
!
      enddo
!
! --- End of installation ----------------------------------------------
!
      write (*,1003)
      close (10)
      stop
!
! --- Formats ----------------------------------------------------------
!
1001  format (///2x,'INSTALL BINARY DIRECT ACCESS FILE : ',a/)
1002  format (2x,'File ',i1,'/9 : ',a,2x,i3,' records')
1003  format (/2x,'DONE'/)
!
2001  format (/2x,'Error Open File : ',a/)
2002  format (/2x,'Error Read File : ',a/)
2003  format (/2x,'Error Write File : ',a/)
!
3001  format (12x,f10.2,f8.0,3i3)
3002  format (i4)
3003  format (f20.16)
3004  format (2f14.0)
!
      end
